Delphi Magazine Collection 2001/Delphi Magazine Collection 20001 (2001).iso/DISKS/Issue56/System/RASPhoneBook.pas

Pascal/Delphi Source File | 2000-03-04 | 14.3 KB | 366 lines

unit RASPhoneBook;

interface

uses
    Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, RASBase;

type
    TRasDialParams = record
    dwSize: Integer;
    EntryName: array [0..256] of Char;
    PhoneNumber: array [0..128] of Char;
    CallbackNumber: array [0..128] of Char;
    UserName: array [0..256] of Char;
    Password: array [0..256] of Char;
    Domain: array [0..15] of Char;
    end;

    TRasDialParamsNT4_2000 = record
    dwSize: Integer;
    EntryName: array [0..256] of Char;
    PhoneNumber: array [0..128] of Char;
    CallbackNumber: array [0..128] of Char;
    UserName: array [0..256] of Char;
    Password: array [0..256] of Char;
    Domain: array [0..15] of Char;
        SubEntry: Integer;
        CallbackId: Integer;
    end;

    TRasEntry = record
    dwSize, Options: Integer;                                                     // General stuff
    CountryID, CountryCode: Integer;                                              // Phone/Country info
    AreaCode: array [0..10] of Char;
    LocalPhoneNumber: array [0..128] of Char;
    AlternateOffset: Integer;
    ipaddr, ipaddrDns, ipaddrDnsAlt, ipaddrWins, ipaddrWinsAlt: Integer;          // PPP/Ip
    FrameSize, NetProtocols, FramingProtocol: Integer;                            // Framing
    Script: array [0..Max_Path - 1] of Char;                                      // Scripting
    AutodialDll: array [0..Max_Path - 1] of Char;                                 // AutoDial
    AutodialFunc: array [0..Max_Path - 1] of Char;
    DeviceType: array [0..16] of Char;                                            // Device
    DeviceName: array [0..128] of Char;
    X25PadType: array [0..32] of Char;                                            // X.25
    X25Address: array [0..200] of Char;
    X25Facilities: array [0..200] of Char;
    X25UserData: array [0..200] of Char;
    Channels: Integer;
    Reserved1, Reserved2: Integer;
    end;

    TRASPhoneBookManager = class (TRASBaseComponent)
    private
        { Private declarations }
        fItemIndex: Integer;
        fEntries, fDummy2: TStrings;
        fPhoneBookFileName: String;
        procedure SetItemIndex (Value: Integer);
        function PhoneBookNameAsPChar: PChar;
        procedure SetPhoneBookFileName (const Value: String);
        function GetDialParameters (Index: Integer): String;
        function GetEntryProperties (Index: Integer): String;
        procedure SetDialParameters (Index: Integer; const Value: String);
        procedure SetEntryProperties (Index: Integer; const Value: String);
        function InternalGetDialParameters (var Dest: TRasDialParamsNT4_2000; var GotPassword: Bool): Integer;
        function InternalGetEntryProperties (var Dest: TRASEntry): Boolean;
        function InternalSetEntryProperties (var Dest: TRASEntry; BufSize: Integer): Integer;
    protected
        { Protected declarations }
    public
        { Public declarations }
        constructor Create (AOwner: TComponent); override;
        destructor Destroy; override;
        function Add: Boolean;
        function Delete: Boolean;
        function Edit: Boolean;
        function Rename (const NewName: String): Boolean;
        function ValidateEntryName (const EntryName: String): Boolean;
        procedure Refresh;
    published
        { Published declarations }
        property ItemIndex: Integer read fItemIndex write SetItemIndex stored False;
        property PhoneBookFileName: String read fPhoneBookFileName write SetPhoneBookFileName;
        property Entries: TStrings read fEntries write fDummy2 stored False;
        property UserName: String index 0 read GetDialParameters write SetDialParameters stored False;
        property Password: String index 1 read GetDialParameters write SetDialParameters stored False;
        property PhoneNumber: String index 0 read GetEntryProperties write SetEntryProperties stored False;
        property DeviceType: String index 1 read GetEntryProperties write SetEntryProperties stored False;
        property DeviceName: String index 2 read GetEntryProperties write SetEntryProperties stored False;
    end;

procedure Register;

implementation

// TRASPhoneBook

constructor TRASPhoneBookManager.Create (AOwner: TComponent);
begin
    Inherited Create (AOwner);
    fEntries := TStringList.Create;
    Refresh;
end;

destructor TRASPhoneBookManager.Destroy;
begin
    fEntries.Free;
    Inherited;
end;

procedure TRASPhoneBookManager.SetPhoneBookFileName (const Value: String);
begin
    if (fPhoneBookFileName <> Value) and (FileExists (Value) or (Value = '')) then begin
        fPhoneBookFileName := Value;
        Refresh;
    end;
end;

function TRASPhoneBookManager.PhoneBookNameAsPChar: PChar;
begin
    if fPhoneBookFileName = '' then
        Result := Nil else Result := PChar (fPhoneBookFileName);
end;

procedure TRASPhoneBookManager.Refresh;
type
    TRasEntryName = record
        dwSize: Integer;
    szEntryName: array [0..257] of Char;
    end;

    TRasEntryName2000 = record
        dwSize: Integer;
    szEntryName: array [0..257] of Char;
        dwFlags: Integer;
        szPhonebookPath: array [0..Max_Path] of Char;
    end;
var
    CurEntry, Buffer: PChar;
    Idx, BufSize, NumEntries, EntrySize: Integer;
    RasEnumEntries: function (Reserved, Phonebook, Buffer: PChar;
                              var BufSize, NumEntries: Integer): Integer; stdcall;
begin
    if Available then begin
        // First off, refresh the entries list
        fEntries.Clear;
        RasEnumEntries := GetProc ('RasEnumEntriesA');
        EntrySize := sizeof (TRasEntryName);
        if Win2000 then EntrySize := sizeof (TRasEntryName2000);

        // Make a dummy call to get the wanted buffer size
        Idx := EntrySize; BufSize := sizeof (Idx);
        RasEnumEntries (Nil, PhoneBookNameAsPChar, @Idx, BufSize, NumEntries);

        // Now do it for real
        Buffer := AllocMem (BufSize);
        try
           PInteger (Buffer)^ := EntrySize;
           if CallProc (RasEnumEntries (Nil, PhoneBookNameAsPChar, Buffer, BufSize, NumEntries)) then begin
               CurEntry := Buffer;
                for Idx := 0 to NumEntries - 1 do begin
                    fEntries.Add (CurEntry + sizeof (Integer));
                    Inc (CurEntry, EntrySize);
                end;
            end;
        finally
            FreeMem (Buffer);
            if fEntries.Count > 0 then fItemIndex := 0 else fItemIndex := -1;
        end;
    end;
end;

procedure TRASPhoneBookManager.SetItemIndex (Value: Integer);
begin
    if (Value >= 0) and (Value < fEntries.Count) and (fEntries.Count > 0) then fItemIndex := Value;
end;

function TRASPhoneBookManager.Add: Boolean;
var
    RasCreatePhoneBookEntry: function (WndParent: hWnd; Phonebook: PChar): Integer; stdcall;
begin
    Result := False;
    if Available then begin
       RasCreatePhoneBookEntry := GetProc ('RasCreatePhonebookEntryA');
       if Assigned (RasCreatePhoneBookEntry) then
           Result := CallProc (RasCreatePhoneBookEntry (Application.Handle, PhoneBookNameAsPChar));
       if Result then Refresh;
    end;
end;

function TRASPhoneBookManager.Delete: Boolean;
var
    RasDeleteEntry: function (Phonebook, EntryName: PChar): Integer; stdcall;
begin
    Result := False;
    if Available and (fItemIndex >= 0) then begin
       RasDeleteEntry := GetProc ('RasDeleteEntryA');
       if Assigned (RasDeleteEntry) then Result := CallProc (RasDeleteEntry (PhoneBookNameAsPChar, PChar (fEntries [fItemIndex])));
       if Result then Refresh;
    end;
end;

function TRASPhoneBookManager.Edit: Boolean;
var
    RasEditPhonebookEntry: function (WndParent: hWnd; Phonebook, EntryName: PChar): Integer; stdcall;
begin
    Result := False;
    if Available and (fItemIndex >= 0) then begin
       RasEditPhonebookEntry := GetProc ('RasEditPhonebookEntryA');
       if Assigned (RasEditPhonebookEntry) then
           Result := CallProc (RasEditPhonebookEntry (Application.Handle, PhoneBookNameAsPChar, PChar (fEntries [fItemIndex])));
       if Result then Refresh;
    end;
end;

function TRASPhoneBookManager.ValidateEntryName (const EntryName: String): Boolean;
var
    RasValidateEntryName: function (Phonebook, EntryName: PChar): Integer; stdcall;
begin
    Result := False;
    if Available then begin
       RasValidateEntryName := GetProc ('RasValidateEntryNameA');
       if Assigned (RasValidateEntryName) then Result := CallProc (RasValidateEntryName (PhoneBookNameAsPChar, PChar (EntryName)));
    end;
end;

function TRASPhoneBookManager.Rename (const NewName: String): Boolean;
var
    RasRenameEntry: function (Phonebook, OldName, NewName: PChar): Integer; stdcall;
begin
    Result := False;
    if Available and (fItemIndex >= 0) and ValidateEntryName (NewName) then begin
       RasRenameEntry := GetProc ('RasRenameEntryA');
       if Assigned (RasRenameEntry) then
           Result := CallProc (RasRenameEntry (PhoneBookNameAsPChar, PChar (fEntries [fItemIndex]), PChar (NewName)));
       if Result then Refresh;
    end;
end;

function TRASPhoneBookManager.InternalGetDialParameters (var Dest: TRasDialParamsNT4_2000; var GotPassword: Bool): Integer;
var
    RasGetEntryDialParams: function (Phonebook: PChar; var RasDialParams: TRasDialParamsNT4_2000; var GotPassword: Bool): Integer; stdcall;
begin
    Result := 0;
    if Available and (fItemIndex >= 0) then begin
        RasGetEntryDialParams := GetProc ('RasGetEntryDialParamsA');
        if Assigned (RasGetEntryDialParams) then begin
            if Win2000 or WinNT4 then Dest.dwSize := sizeof (TRasDialParamsNT4_2000)
            else Dest.dwSize := sizeof (TRasDialParams);
            StrPCopy (Dest.EntryName, fEntries [fItemIndex]);
            if CallProc (RasGetEntryDialParams (PhoneBookNameAsPChar, Dest, GotPassword)) then Result := Dest.dwSize;
        end;
    end;
end;

function TRASPhoneBookManager.GetDialParameters (Index: Integer): String;
var
    GotPassword: Bool;
    Params: TRasDialParamsNT4_2000;
begin
    if InternalGetDialParameters (Params, GotPassword) > 0 then begin
        if not GotPassword then Params.Password := '---not available---';
        case Index of
            0:     Result := Params.UserName;
            1:     Result := Params.Password;
        end;
    end;
end;

procedure TRASPhoneBookManager.SetDialParameters (Index: Integer; const Value: String);
var
    GotPassword: Bool;
    Params: TRasDialParamsNT4_2000;
    RasSetEntryDialParams: function (Phonebook: PChar; var RasDialParams: TRasDialParamsNT4_2000; RemovePassword: Bool): Integer; stdcall;
begin
    if InternalGetDialParameters (Params, GotPassword) > 0 then begin
        // Can't set username to an empty string.
        if (Index = 0) and (Value = '') then Exit;
        if Index = 0 then StrPCopy (Params.UserName, Value) else StrPCopy (Params.PassWord, Value);
        RasSetEntryDialParams := GetProc ('RasSetEntryDialParamsA');
        if Assigned (RasSetEntryDialParams) then
            CallProc (RasSetEntryDialParams (PhoneBookNameAsPChar, Params, (Index = 1) and (Value = '')));
    end;
end;

function TRASPhoneBookManager.InternalGetEntryProperties (var Dest: TRASEntry): Boolean;
var
    EntrySize, DevInfoSize: Integer;
    Buffer: array [0..10000] of Char;
    RasGetEntryProperties: function (Phonebook, EntryName: PChar; var Entry; var EntrySize: Integer;
                                     DevInfo: Pointer; var DevInfoSize: Integer): Integer; stdcall;
begin
    Result := False;
    if Available and (fItemIndex >= 0) then begin
        RasGetEntryProperties := GetProc ('RasGetEntryPropertiesA');
        if Assigned (RasGetEntryProperties) then begin
            PInteger (@Buffer)^ := sizeof (TRASEntry);
            EntrySize := sizeof (Buffer);  DevInfoSize := 0;
            Result := CallProc (RasGetEntryProperties (PhoneBookNameAsPChar, PChar (fEntries [fItemIndex]), Buffer, EntrySize, Nil, DevInfoSize));
            if Result then Move (Buffer, Dest, sizeof (TRASEntry));
        end;
    end;
end;

function TRASPhoneBookManager.GetEntryProperties (Index: Integer): String;
var
    Props: TRASEntry;
begin
    if InternalGetEntryProperties (Props) then begin
        case Index of
            0:     Result := Props.LocalPhoneNumber;
            1:     Result := Props.DeviceType;
            2:     Result := Props.DeviceName;
        end;
    end;
end;

function TRASPhoneBookManager.InternalSetEntryProperties (var Dest: TRASEntry; BufSize: Integer): Integer;
var
    DevInfoSize: Integer;
    RasGetEntryProperties: function (Phonebook, EntryName: PChar; var Entry: TRASEntry; var EntrySize: Integer;
                                     DevInfo: Pointer; var DevInfoSize: Integer): Integer; stdcall;
begin
    Result := 0;
    if Available and (fItemIndex >= 0) then begin
        RasGetEntryProperties := GetProc ('RasGetEntryPropertiesA');
        if Assigned (RasGetEntryProperties) then begin
            Dest.dwSize := sizeof (TRASEntry);  DevInfoSize := 0;
            if CallProc (RasGetEntryProperties (PhoneBookNameAsPChar, PChar (fEntries [fItemIndex]), Dest, BufSize, Nil, DevInfoSize)) then
                Result := BufSize;
        end;
    end;
end;

procedure TRASPhoneBookManager.SetEntryProperties (Index: Integer; const Value: String);
var
    Props: TRASEntry;
    EntrySize, DevInfoSize: Integer;
    Buffer: array [0..10000] of Char absolute Props;
    RasSetEntryProperties: function (Phonebook, EntryName: PChar; var Entry: TRASEntry;
                                     var EntrySize: Integer; DevInfo: Pointer; var DevInfoSize: Integer): Integer; stdcall;
begin
    EntrySize := InternalSetEntryProperties (Props, sizeof (Buffer));
    if EntrySize > 0 then begin
        case Index of
            0:    StrPCopy (Props.LocalPhoneNumber, Value);
            1:    StrPCopy (Props.DeviceType, Value);
            2:    StrPCopy (Props.DeviceName, Value);
        end;

        DevInfoSize := 0;
        RasSetEntryProperties := GetProc ('RasSetEntryPropertiesA');
        if Assigned (RasSetEntryProperties) then
            CallProc (RasSetEntryProperties (PhoneBookNameAsPChar, PChar (fEntries [fItemIndex]), Props, EntrySize, Nil, DevInfoSize));
    end;
end;

procedure Register;
begin
    RegisterComponents ('DelphiMag', [TRASPhoneBookManager]);
end;

end.